home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / timer.bas < prev    next >
BASIC Source File  |  1997-06-14  |  2KB  |  78 lines
  1. Attribute VB_Name = "MTimer"
  2. Option Explicit
  3.  
  4. Const cTimerMax = 100
  5.  
  6. ' Array of timers
  7. Public aTimers(1 To cTimerMax) As CTimer
  8.  
  9. Function TimerCreate(timer As CTimer) As Boolean
  10.     ' Create the timer
  11.     timer.TimerID = SetTimer(0&, 0&, timer.Interval, AddressOf TimerProc)
  12.     If timer.TimerID Then
  13.         TimerCreate = True
  14.         Dim i As Integer
  15.         For i = 1 To cTimerMax
  16.             If aTimers(i) Is Nothing Then
  17.                 Set aTimers(i) = timer
  18.                 TimerCreate = True
  19.                 Exit Function
  20.             End If
  21.         Next
  22.         timer.ErrRaise eeTooManyTimers
  23.     Else
  24.         ' TimerCreate = False
  25.         timer.TimerID = 0
  26.         timer.Interval = 0
  27.     End If
  28. End Function
  29.  
  30. Public Function TimerDestroy(timer As CTimer) As Long
  31.     ' TimerDestroy = False
  32.     ' Find and remove this timer
  33.     Dim i As Integer, f As Boolean
  34.     For i = 1 To cTimerMax
  35.         ' Find timer in array
  36.         If Not aTimers(i) Is Nothing Then
  37.             If timer.TimerID = aTimers(i).TimerID Then
  38.                 f = KillTimer(hNull, timer.TimerID)
  39.                 ' Remove timer and set reference to nothing
  40.                 Set aTimers(i) = Nothing
  41.                 TimerDestroy = True
  42.                 Exit Function
  43.             End If
  44.         Else
  45.             TimerDestroy = True
  46.             Exit Function
  47.         End If
  48.     Next
  49. End Function
  50.  
  51.  
  52. Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, _
  53.                      ByVal idEvent As Long, ByVal dwTime As Long)
  54.     Dim i As Integer
  55.     ' Find the timer with this ID
  56.     For i = 1 To cTimerMax
  57.         If idEvent = aTimers(i).TimerID Then
  58.             ' Generate the event
  59.             aTimers(i).PulseTimer
  60.             Exit Sub
  61.         End If
  62.     Next
  63. End Sub
  64.  
  65.  
  66. Private Function StoreTimer(timer As CTimer)
  67.     Dim i As Integer
  68.     For i = 1 To cTimerMax
  69.         If aTimers(i) Is Nothing Then
  70.             Set aTimers(i) = timer
  71.             StoreTimer = True
  72.             Exit Function
  73.         End If
  74.     Next
  75. End Function
  76.  
  77.  
  78.